perm filename RESPC.F4[PAG,LCS]4 blob
sn#374032 filedate 1978-08-16 generic text, type T, neo UTF8
00100 SUBROUTINE RESPC
00200 COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,JPQ
00300 1 /IPG/IPG,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),
00400 1 RCLEF(0/7) /IVV/IV(1)
00500 COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
00600 C ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
00700 COMMON/XRN/RN(1) /SF/KL,RT,KP,STFSZ,NAMX
00800 1 /PTR/KWDS(1)/LLL/L,LL,I,IX/XXX/LK,LP,JY /JN/J,N
00900 C INCREASE DIMENSION OF KWDS FOR VERY FULL PAGES.
01000 DIMENSION NRD(100),MM(1500),NN(1500),BARS(509),E(100),F(100),
01100 1 G(100),H(100),KPN(1),HH(100),HHH(100),DUMMY(100),PGTRN(500)
01200 INTEGER DUMMY
01300 COMMON /PX/PN(1) /Q/Q(1)
01400 1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
01500 1 /KBAR/KBAR(1) /RSP/KNM(1) /ENDL/ENDLN,KQ,NAME,NMPG,SPCNT
01600 DATA FIB/.8/ ,RSPC/28./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
01700 1 ,RLTRSZ/1.0/,SPCPG/2.7/,SPCRX/1.5/ ,BFAC/0.7/
01800 C RSPC=28 SEEMS TO BE ARBITRARY. SPCRX USED IN RHYTH RESPACE.
01900 EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(MM,RN)
02000 1,(NN,RN(501)),(KPN,PN),(KS,RS),(BARS,KBAR(4)),(HHH,RN(2250))
02100 1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
02200 1,(LASTNM,KBAR(3)),(LCNT,IV(45)),(NDPY,IV(46)),(HH,RN(1250))
02300 1,(E,RN(1000)),(F,RN(2500)),(G,RN(2700)),(H,RN(2850))
02400 1,(DUMMY,RN(1400)),(PGTRN(1),KBAR(516))
02500 C RQ(2) IS R4, RQ(3) IS R5 ETC.
02600
02700 IF(NMPG.NE.'PAGEA')GO TO 2000
02800 C SHOULD HANDLE UP TO 104 INPUT FILES. ADD HERE AND LATER FOR MORE RANGE.
02900 RNEXT=0
03000 2000 SPCNT=1.0
03100 JX=0
03200 JCEN=0
03300 C FLAG FOR CENTERED RESTS.
03400 XT=0
03500 PX=0
03600 CALL SHFT1(KQ)
03700 KK=L
03800 CC TYPE 3001,L
03900 C DELETES EXTRA BAR LINES, ETC.
04000 IF(IPG)CALL RESTS
04100 C??? IF(N)RETURN
04200 C N IS NEG., ONLY RESTS WERE ON THIS LINE. (WHAT ABOUT LAST LINE???)
04300 C FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
04400 CALL SHIFT
04500 C L=NUMBER OF ITEMS FOR RHY RECONS.
04600 JJ2=L+2
04700 C FOR WDCNT IN .PAG FILE
04800 N=0
04900 S=-100
05000 R=0
05100 KCLEF=0
05200 NOGRCE=-1
05300 C GRACE NOTE FLAG
05400 TTT=0
05500 C FOR IRREG. NUMS. OF STAVES.
05600
05700
05800 161 DO 601 K=1,L
05900 R=CODEN(KPN,K,Q,J)
06000 RZ=Q(J)
06100 CX J=KPN(K)
06200 CC N=N+1
06300 CC NN(N)=0
06400 CC MM(N)=J+3
06500 CALL MMNN(3)
06600 CX R=Q(J+1)
06700 IF(R.GT.2)GO TO 1801
06800 IF(Q(J+2).GT.TTT)TTT=Q(J+2)
06900 C FINDS HIGHEST STAFF NUM. NOW WE CAN HAVE IRREG. NUMS. OF STAVES.
07000 IF(R.NE.1)GO TO 2801
07100 IF(RZ.LT.7)GO TO 601
07200 IF(Q(J+9).LE.0)GO TO 601
07300 C P9=-1 FOR NOTES WITHOUT LEDGER LINES (HENCE NO RHYTHM.)
07400 IF(Q(J+9).NE.4./88.)GO TO 702
07500 CC IF(Q(J+9).GT..05)GO TO 702
07600 CC IF(Q(J+8).EQ.1000)GO TO 601
07700 C SKIP GRACE NOTE, OR NOTES WITHOUT RHY., OR .LT.1/88 NOTES.
07800 NOGRCE=0
07900 GO TO 601
08000 CCC2801 IF(R.NE.2)GO TO 1801
08100 2801 IF(RZ.NE.7)GO TO 3801
08200 C DELETE ALL UP TO LABEL 1801 LATER. NEW CENTERED REST FEATURE. 5/29/78
08300 NN(N)=R
08400 GO TO 688
08500 3801 IF(RZ.LT.5)GO TO 601
08600 IF(IPG)GO TO 1801
08700 IF(RZ.LT.6)GO TO 1801
08800 RS=Q(J+3)
08900 C GET POS. OF CENTERED WHOLE REST
09000 TT=0
09100 B=Q(J+2)
09200 C GET THE STAFF NUM.
09300 DO 602 M=1,L
09400 T=CODEN(KPN,M,Q,JJ)
09500 A=Q(JJ+3)
09600 C GET POS. OF ITEM
09700 IF(A.GT.RS)GO TO 602
09800 C JUMP IF ITEM IS TO RIGHT OF REST
09900 IF(T.NE.4)GO TO 602
10000 C IS THE ITEM A BAR LINE
10100 IF(A.GT.TT)TT=A
10200 C FINDS BAR LINE CLOSEST TO LEFT OF REST
10300 602 CONTINUE
10400 C NOW T HAS POS OF CLOSEST BAR, KSIG OR METER TO LEFT OF REST
10500 T=20000
10600 A=20000
10700 C NOW FIND NOTE OR REST CLOSEST TO RIGHT OF BAR, ETC.
10800 DO 613 M=1,L
10900 IF(CODEN(KPN,M,Q,JJ).GT.2)GO TO 613
11000 IF(Q(JJ).LT.7)GO TO 609
11100 C SKIP IF RHYTH NOT IN P9
11200 IF(Q(JJ+9).LT..05)GO TO 613
11300 C IGNORES GRACE NOTES. ****** THERE COULD BE SOME RARE PROBLEMS HERE *****
11400 609 B=Q(JJ+3)
11500 C POS. OF ITEM
11600 X=B-TT
11700 IF(X)GO TO 613
11800 C JUMP IF ITEM IS TOO FAR TO LEFT
11900 IF(X.GT.A)GO TO 613
12000 A=X
12100 T=B
12200 C T = POS OF NOTE OR REST NEAREST BAR, ETC.
12300 613 CONTINUE
12400 IF(T.NE.20000)GO TO 612
12500 C JUMP IF NOTE OR REST FOUND
12600 JCEN=-1
12700 GO TO 1801
12800 612 Q(J+3)=T
12900 C THE REST IS NOW MOVED NEAR TO BAR, PROPER POS.
13000 C MUST ALIGN REST WITH FIRST RHYTH ON OTHER STAFF.
13100 C THIS WILL IGNORE WHOLE RESTS IN CENTER OF MEASURE.
13200 1801 IF(R.LT.4)GO TO 702
13300 IF(R.EQ.17)GO TO 1702
13400 IF(R.EQ.18)GO TO 1702
13500 IF(R.EQ.10)GO TO 702
13600 C FOUND A NUMBER. USE THIS IN RESTP
13700 IF(R.LE.7)GO TO 30
13800 IF(R.NE.44)GO TO 601
13900 IF(RZ.EQ.2)GO TO 601
14000 C RZ=2= BAR LINE ON UPPER STAFF
14100 IF(Q(J+6).EQ.0)GO TO 601
14200 IF(Q(J+5).EQ.0)GO TO 601
14300 C GETS LEFT END OF LINES, CRESC., DASHES.
14400 GO TO 604
14500 30 IF(R.NE.7)GO TO 605
14600 IF(RZ.LT.5)GO TO 604
14700 C JUMP FOR STANDARD TRILL
14800 RS=Q(J+7)
14900 IF(RS.EQ.1)GO TO 604
15000 IF(ABS(RS).GE.3)GO TO 604
15100 C JUMP FOR 8VA, 15MA, ELSE THIS IS A PEDAL MARK WITHOUT LINE.
15200 GO TO 601
15300 605 IF(R.NE.4)GO TO 604
15400 IF(RZ.LE.3)GO TO 702
15500 C JUMP IF IT IS A BAR LINE
15600 CC IF(RZ.LT.4)GO TO 601
15700 IF(Q(J+6).NE.0)GO TO 604
15800 C GO GET OTHER POS OF LINE
15900 GO TO 601
16000 1702 IF(Q(J+4).NE.0)GO TO 601
16100 IF(Q(J+2).NE.0)GO TO 601
16200 C IGNORE METER NOT IN VERT. POS. 0. (PUT IN OTHER PROGS!)
16300 702 NN(N)=R
16400 GO TO 601
16500 C NEXT FOR MULTIPOSITION ITEMS: LINES, SLURS, BEAMS, TRILL, 8VA
16600 604 CALL MMNN(6)
16700 C NEXT POS2, 3 AND 4 OF CERTAIN ITEMS
16800 IF(R.NE.6)GO TO 601
16900 C NEXT FOR BEAMS
17000 IF(RZ.LT.8)GO TO 608
17100 IF(Q(J+10).EQ.0)GO TO 608
17200 IF(Q(J+8))GO TO 608
17300 C P8<0 = P8=P3 (PARTIAL BEAM TO LEFT)
17400 IF(Q(J+7).GT.0)CALL MMNN(8)
17500 C NEXT SHIFTS P8 OF COMPOSITE BEAMS
17600 608 IF(RZ.LT.7)GO TO 601
17700 IF(Q(J+7))GO TO 688
17800 C P7 IS NEG FOR TREMOLO
17900 IF(Q(J+8).EQ.0)GO TO 601
18000 C P8 NEG OR POS = POS3 IN P9; P8=0= P9 IS NUM.
18100 688 IF(Q(J+9).GT.0)CALL MMNN(9)
18200 C FOUND A POS. IN P9
18300 601 CONTINUE
18400 KPG=TTT+1
18500 C KPG IS CURRENT NUM. OF STAVES. (ALWAYS START AT STAFF 0!!!!)
18600
18700 C NEXT SORTS THE POINTS
18800 6000 J=1
18900 610 IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
19000 CALL EXCHG(MM(J),NN(J))
19100 C ABOVE EXCHGS --(J) AND --(J+1)
19200 IF(J.EQ.1)GO TO 710
19300 J=J-1
19400 GO TO 610
19500 710 J=J+1
19600 IF(J.LT.N)GO TO 610
19700 C NOW ALL SORTED
19800 CALL FNDEND(R)
19900 CALL SHFTQ(R)
20000 C SHIFTS TO PROPER HORIZ. POS.
20100 IF(IPG)CALL RESTP
20200 C RESTP COMBINES LEFTOVER NUMBERED BARS OF RESTS.
20300 IF(N.LE.0)GO TO 122
20400 C N IS NEG IF ONLY RESTS ON THIS LINE. GO BACK.
20500
20600 DO 119 K=1,150
20700 119 HH(K)=0
20800 C HH ARRAY WILL HOLD FINAL COMPOSITE.
20900 G(1)=0
21000 E(1)=0
21100 F(1)=0
21200 RN(1500)=0
21300 RN(2500)=0
21400 ST=0
21500 C ST=STAFF NUM, T=TOTAL RHYTHMS, J=CNTR OF MAIN POS. ARRAY
21600 C JJ=CNTR FOR 2ND POS. ARRAY, JJJ=CNTR FOR 3RD.
21700 KE=0
21800 J=1000
21900 933 JJ=1500
22000 JJJ=2000
22100 T=0
22200 M=0
22300 A=0
22400 B=0
22500
22600 DO 33 K=1,N
22700 IF(NORH(KK))GO TO 33
22800 CC KK=NN(K)
22900 CC IF(KK.EQ.0)GO TO 33
23000 CC IF(KK.EQ.4)GO TO 2133
23100 CC IF(KK.EQ.17)GO TO 2133
23200 C SKIP OVER STAFF # TRAP WITH BARS, METER, KSIG.
23300 CC IF(KK.EQ.18)GO TO 2133
23400 CC IF(KK.GT.2)GO TO 33
23500 2133 LL=MM(K)-3
23600 IF(KK.LE.2)GO TO 1133
23700 RH=.01
23800 C RHYTHMIC VALUE OF BARLINE, METER, KSIG
23900 CCC IF(KK.NE.4)RH=.6
24000 GO TO 3133
24100 1133 IF(Q(LL+2).NE.ST)GO TO 33
24200 C JUMP IF NOT ON RIGHT STAFF
24300 RA=9
24400 IF(KK.EQ.2)RA=7
24500 IF(Q(LL).LT.RA-2)GO TO 33
24600 C JUMP IF WDCNT IS TOO SHORT
24700 IF(KK.EQ.1)GO TO 433
24800 IF(Q(LL).LT.6)GO TO 433
24900 C NEXT FOR NUMBERED RESTS - SETS RHYTH VALUE BASED ON NUMBER.
25000 RZ=Q(LL+8)
25100 C IF >0, RZ =THE NUMBER, ELSE IT'S A WHOLE REST, CENTERED, ETC.
25200 IF(RZ.LE.0)GO TO 433
25300 Q(LL+7)=3
25400 C 3 IS THE SMALLEST RHYTH VALUE FOR A NUMBERED REST
25500 IF(RZ.LT.8)GO TO 433
25600 Q(LL+5)=-3
25700 C IF NUMB. .GE.8 THEN PRINTS DBL WHOLE REST
25800 RZ=IFIX(RZ/2.0)+1.0
25900 IF(RZ.GT.6)RZ=6
26000 C LIMIT OF 8 ON RHYTH VAL.
26100 Q(LL+7)=RZ
26200 433 RH=Q(LL+IFIX(RA))
26300 IF(RH.EQ.0)GO TO 33
26400 3133 RZ=Q(LL+3)
26500 IF(ZERO(RZ,A).EQ.0)GO TO 133
26600 C JUMP IF THIS NOTE IN SAME POS. AS LAST ONE.
26700 RRH=RH
26800 C SAVE RHYTH TO CHECK WITH OTHER IN SAME POS.
26900 TT=T
27000 C SAVE TOTAL RHYTHM BEFORE THIS NOTE.
27100 J=J+1
27200 C UPDATE COUNTER IN POSITION ARRAY
27300 T=T+RH
27400 C ADD TO TOTAL RHYTHM
27500 RN(J)=T
27600 A=Q(LL+3)
27700 C SAVE POS. OF THIS NOTE.
27800 GO TO 33
27900 133 IF(RH.EQ.RHH)GO TO 33
28000 C IGNORE 2ND RHYTH IF SAME AS FIRST
28100 IF(ZERO(RZ,B).EQ.0)GO TO 333
28200 C JUMP IF A THIRD DIFFERENT RHYTHM IN SAME POS. (THIS IS THE LIMIT!)
28300 TTT=TT
28400 C SAVE TOTAL RHYTHM TO THIS POINT.
28500 TT=TT+RH
28600 JJ=JJ+1
28700 C UPDATE COUNTER FOR 2ND ARRAY
28800 RN(JJ)=TT
28900 RRRH=RH
29000 B=A
29100 GO TO 33
29200 333 IF(RH.EQ.RRRH)GO TO 33
29300 TTT=TTT+RH
29400 JJJ=JJJ+1
29500 RN(JJJ)=TTT
29600 33 CONTINUE
29700 C NOW COMPARE THIS WITH BASIC RHYTHM ARRAY (STARTS AT RN(1001)
29800 IF(ST.NE.0)GO TO 733
29900 KE=J-999
30000 C TOTAL NUM OF RHYTHMS ON STAFF1.
30100 CC IF(JPG.EQ.0)GO TO 2233
30200 IF(KPG.LE.1)GO TO 2233
30300 C KPG=0=PARTS; =1=PAGE, 1 STAFF
30400 C JUMP IF ONLY ONE STAFF
30500 C****733 KF=J-2499
30600 C KF=NUM OF RHYTHMS ON NEXT STAFF. **** NEVER USED ****
30700 733 ST=ST+1
30800 IF(ST.GT.1)GO TO 833
30900 C JUMP IF ALL STAVES HAVE BEEN READ.
31000 1233 J=2500
31100 GO TO 933
31200 833 IF(J.NE.2500)GO TO 1533
31300 C JUMP IF THERE IS ONLY ONE LINE OF RHYTHM
31400 C NOW LINE ONE STARTS AT RN(1001), LINE 2 AT RN(2501)
31500
31600 2233 CALL RLOOP(HH,E,KE)
31700 C FOR SINGLE STAFF OF RHYTHM
31800 KL=KE
31900 GO TO 1333
32000 1533 K=1
32100 L=1
32200 M=0
32300 19 KK=K
32400 LL=L
32500 1 SM=10000
32600 K=K+1
32700 IF(K.GT.KE)GO TO 10
32800 4 L=L+1
32900 Y=F(L)
33000 B=Y-F(L-1)
33100 IF(B.LT.SM)SM=B
33200 2 X=E(K)
33300 A=X-E(K-1)
33400 C A AND B HAVE TRUE DURATIONS NOW
33500 IF(A.LT.SM)SM=A
33600 C SM = SMALLEST RHYTH VALUE BEFORE NEXT CONTACT
33700 IF(ZERO(X,Y).EQ.0)GO TO 3
33800 C JUMP IF EQUAL RHYTHS
33900 IF(X.GT.Y)GO TO 4
34000 K=K+1
34100 C STEP FORWARD UNTIL X IS .GT. Y
34200 GO TO 2
34300 3 IF(K.NE.KK+1)GO TO 13
34400 IF(L.NE.LL+1)GO TO 14
34500 M=M+1
34600 G(M)=E(KK)
34700 GO TO 19
34800 13 IF(L.NE.LL+1)GO TO 15
34900 DO 16 J=KK,K-1
35000 M=M+1
35100 16 G(M)=E(J)
35200 GO TO 19
35300 14 DO 17 J=LL,L-1
35400 M=M+1
35500 17 G(M)=F(J)
35600 GO TO 19
35700 15 XM=SM-.001
35800 M=M+1
35900 P=E(KK)
36000 G(M)=P
36100 7 KK=KK+1
36200 LL=LL+1
36300 YM=SM*1.5
36400 C THIS COULD BE *2 (NOTE /16/8./ VS. /6/12/ )
36500 S=P
36600 T=P
36700 27 A=E(KK)
36800 B=F(LL)
36900 IF(ZERO(A,B).EQ.0)GO TO 19
37000 X=ZERO(A,P)
37100 Y=ZERO(B,P)
37200 C FUNCT. ZERO: ZERO=B-P, IF(ABS(ZERO).LT..01)ZERO=0
37300 S=E(KK-1)
37400 T=F(LL-1)
37500 9 IF(A-S.LT.X-.01)X=ZERO(A,S)
37600 IF(B-T.LT.Y-.01)Y=ZERO(B,T)
37700 IF(A.GT.B+.01)GO TO 8
37800 B=A
37900 KK=KK+1
38000 62 IF(X.GT.YM)GO TO 5
38100 IF(X.EQ.0)GO TO 27
38200 P=P+SM
38300 25 M=M+1
38400 G(M)=P
38500 GO TO 27
38600 5 P=P+SM
38700 IF(P)GO TO 203
38800 C IF(P)ERROR
38900 IF(P.LT.B-.01)GO TO 5
39000 GO TO 25
39100 8 X=Y
39200 LL=LL+1
39300 GO TO 62
39400 10 M=M+1
39500 G(M)=E(KE)
39600 CC TYPE 410,(E(K),K=1,KE)
39700 CC TYPE 410,(F(K),K=1,KF)
39800 CC TYPE 410,(G(K),K=1,M)
39900 CBCB WRITE(21,410)(E(K),K=1,KE)
40000 CB WRITE(21,410)(F(K),K=1,KF)
40100 CB WRITE(21,410)(G(K),K=1,M)
40200 410 FORMAT(10F7.2)
40300 C NEXT SECTION SETS UP COMPLETE RHYTH COMPOSITE(NEGS. OR NON-SPC VALS.)
40400 1033 JJ=1
40500 H(1)=0
40600 J=1
40700 K=2
40800 L=2
40900 511 IF(J.EQ.M)GO TO 911
41000 J=J+1
41100 X=G(J)
41200 1211 A=E(K)
41300 B=F(L)
41400 Y=ZERO(X,A)
41500 Z=ZERO(X,B)
41600 IF(A-B.GT..01)GO TO 1111
41700 IF(Y.EQ.0)GO TO 1311
41800 IF(X.LT.A-.01)GO TO 1111
41900 K=K+1
42000 1411 JJ=JJ+1
42100 H(JJ)=-A
42200 GO TO 1211
42300 1111 IF(Z.EQ.0)GO TO 1311
42400 IF(X.LT.B-.01)GO TO 1311
42500 L=L+1
42600 A=B
42700 GO TO 1411
42800
42900 1311 JJ=JJ+1
43000 H(JJ)=X
43100 IF(Y.EQ.0)GO TO 611
43200 IF(Z.EQ.0)GO TO 711
43300 IF(ZERO(A,B).EQ.0)GO TO 511
43400 P=A
43500 IF(P.GT.B+.01)GO TO 811
43600 IF(P.GT.X+.01)GO TO 511
43700 K=K+1
43800 GO TO 1011
43900 811 P=B
44000 IF(P.GT.X+.01)GO TO 511
44100 L=L+1
44200 1011 JJ=JJ+1
44300 H(JJ)=-P
44400 C NON-SPACED RHYTHS ARE NEG.
44500 GO TO 511
44600 611 K=K+1
44700 IF(Z.GT.0)GO TO 511
44800 711 L=L+1
44900 GO TO 511
45000 911 IF(HH(2).EQ.0)GO TO 2011
45100 K=2
45200 J=2
45300 L=1
45400 HHH(1)=0
45500 1511 IF(J.GT.JJ)GO TO 1811
45600 P=H(J)
45700 A=ABS(P)
45800 B=ABS(HH(K))
45900 IF(ZERO(B,A).EQ.0)GO TO 1611
46000 IF(A.GT.B)GO TO 1711
46100 J=J+1
46200 GO TO 1911
46300 1711 P=HH(K)
46400 GO TO 2211
46500 1611 J=J+1
46600 2211 K=K+1
46700 1911 L=L+1
46800 HHH(L)=P
46900 GO TO 1511
47000 2011 CALL RLOOP(HH,H,JJ)
47100 KL=JJ
47200 GO TO 2111
47300 1811 CALL RLOOP(HH,HHH,L)
47400 KL=L
47500 2111 IF(ST.GE.KPG)GO TO 1333
47600 CALL RLOOP(E,G,M)
47700 KE=M
47800 C GO WAY BACK AND READ ANOTHER LINE.
47900 GO TO 1233
48000 1333 E(1)=0
48100 GO TO 2333
48200 TYPE 410,(HH(K),K=1,KL)
48300 WRITE(21,410)(HH(K),K=1,KL)
48400 2333 JD=1
48500 C JD IS COUNTER FOR DUMMY POSITIONS.
48600 DUMMY(1)=1
48700 ST=0
48800 183 B=0
48900 LL=2
49000
49100 DO 181 K=1,N
49200 IF(NORH(L))GO TO 181
49300 C LOOK FOR DUMMY RHYTHMS.
49400 IF(L.LE.2)GO TO 2184
49500 RZ=.01
49600 C RHYTHMIC VALUE OF BAR, METER, KSIG. CHANGED TO ABS. SIZE LATER.
49700 GO TO 1184
49800 2184 LF=MM(K)
49900 IF(Q(LF-1).NE.ST)GO TO 181
50000 C FOUND RHYTH ON RIGHT STAFF (LF PNTS TO PARAM 3)
50100 J=6
50200 IF(L.EQ.2)J=4
50300 RZ=Q(LF+J)
50400 1184 B=B+RZ
50500 184 V=ABS(HH(LL))
50600 IF(ZERO(B,V).GT.0)GO TO 182
50700 C FOUND RHYTH MATCH
50800 JD=JD+1
50900 DUMMY(JD)=LL
51000 LL=LL+1
51100 GO TO 181
51200 182 IF(B.LT.V-.01)GO TO 181
51300 LL=LL+1
51400 GO TO 184
51500 181 CONTINUE
51600 ST=ST+1
51700 IF(ST.LT.KPG)GO TO 183
51800
51900 C NEXT SORT DUMMY ARRAY
52000 J=0
52100 185 DO 186 K=2,JD
52200 IF(DUMMY(K).NE.DUMMY(K-1))GO TO 187
52300 DO 188 LL=K,JD
52400 188 DUMMY(LL-1)=DUMMY(LL)
52500 JD=JD-1
52600 GO TO 185
52700 187 IF(DUMMY(K).GT.DUMMY(K-1))GO TO 186
52800 CALL EXCH(DUMMY(K),DUMMY(K-1))
52900 GO TO 185
53000 186 CONTINUE
53100 C NOW DUMMY CONTAINS ALL NON-DUMMY RHYTHS!!!
53200 PX=0
53300 LF=0
53400 K=1
53500 V=0
53600
53700 81 K=K+1
53800 IF(K.GT.KL)GO TO 1433
53900 B=HH(K)
54000 A=B-V
54100 V=B
54200 IF(V)GO TO 82
54300 85 W=V
54400 IF(A.GT.0.01)GO TO 89
54500 C .GT. BECAUSE OF ROUND-OFF ERROR
54600 T=5
54700 IF(HH(K+1)-V.LE..01)T=2
54800 PX=PX+T
54900 C THIS FOR BARS, KSIG, METER
55000 GO TO 189
55100 89 PX=PX+14.0*EXP(ALOG(A)*0.5849624)
55200 C THIS IS EXP((ALOG(A)/ALOG(2.0))*ALOG(1.5)) NOT FIBBONACI (1.618)
55300 CC89 PX=PX+PFIBX(A)
55400 189 E(K)=PX
55500 IF(LF.NE.0)GO TO 86
55600 GO TO 81
55700 82 LF=K
55800 83 K=K+1
55900 V=HH(K)
56000 IF(V)GO TO 83
56100 A=V-W
56200 GO TO 85
56300 86 LL=LF-1
56400 D=E(K)-E(LL)
56500 87 S=-HH(LF)-HH(LL)
56600 T=HH(K)-HH(LL)
56700 T=S/T
56800 C THIS FINDS POS OF NON-IMPORTANT RHY BETWEEN IMPORTANT ONES.
56900 E(LF)=E(LL)+D*T
57000 LF=LF+1
57100 IF(LF.NE.K)GO TO 87
57200 LF=0
57300 GO TO 81
57400
57500 1433 GO TO 2433
57600 TYPE 410,(E(K),K=1,KL)
57700 WRITE(21,410)(E(K),K=1,KL)
57800 C 5 IS SPACE AFTER 1ST BARLINE
57900 2433 R8=RNEXT
58000 C POS OF 1ST BAR = END OF PREV. LINE
58100 IF(ENDLN.EQ.0)RNEXT=9
58200 C MAKES ROOM FOR 1ST CLEF.
58300 KL=KL-1
58400 J=0
58500 R5=0
58600 KK=1
58700 JD=1
58800 W=0
58900 LF=0
59000
59100 DO 80 K=1,N
59200 IF(NORH(L))GO TO 80
59300 A=Q(MM(K))
59400 IF(ZERO(A,W).EQ.0)GO TO 80
59500 C SKIP IF SAME POS OF NOTE OR REST.
59600 W=A
59700 R7=R8
59800 190 J=J+1
59900 IF(J.LE.KL)GO TO 290
60000 203 FORMAT(' FOUND CENTERED WHOLE REST!')
60100 LL=0
60200 IF(JCEN.GE.0)GO TO 220
60300 TYPE 203
60400 GO TO 121
60410 220 JJJ=-1
60420 L=0
60500 120 W=LL
60600 A=0
60700 DO 124 K=1,N
60800 LF=NN(K)
60900 IF(LF.GT.2)GO TO 124
61000 IF(LF.EQ.0)GO TO 124
61100 KE=MM(K)
61200 IF(Q(KE-1).NE.W)GO TO 124
61300 C ADD UP RHYTHMIC VALUES ON EACH SEPARATE LINE.
61400 JD=6
61500 IF(LF.EQ.2)JD=4
61600 A=A+Q(KE+JD)
61700 124 CONTINUE
61800 TYPE 123,LL,A
61810 LL=LL+1
61820 IF(L.EQ.0)L=A*100.+.5
61825 C SAVE NUM. OF BEATS FIRST TIME.
61830 IF(L.NE.A*100.+.5)JJJ=0
61840 C SET FLAG IF MISMATCH. (JJJ=0=MISMATCH, =-1=MISALIGNED)
61910 IF(LL.LT.KPG)GO TO 120
61920 IF(JJJ.NE.0)GO TO 121
61930 JJJ=0
61940 DO 320 K=2,JJ
61950 A=HH(K)-HH(K-1)
61960 IF(A.LE..01)GO TO 320
61970 C SKIP BAR LINE VALUES (.01)
61980 JJJ=JJJ+1
61990 HH(JJJ)=4./A
62000 C THIS WILL PRINT SMALLEST COMPOSITE RHYTHM
62010 320 CONTINUE
62020 TYPE 420,(HH(K),K=1,JJJ)
62040 PAUSE'****COMPOSITE RHYTHM ERROR - MISALIGNED NOTES****'
62050 GO TO 90
62060 420 FORMAT(10F8.2)
62100 123 FORMAT(' STF',I2,' =',F9.5,' QTRS')
62200 121 PAUSE' *****RHYTHM MISMATCH*****'
62300 GO TO 90
62400 290 IF(DUMMY(JD).NE.J)GO TO 190
62500 JD=JD+1
62600 90 R8=RNEXT+E(J)
62700 R4=R5
62800 R5=A
62900 X=(R8-R7)/(R5-R4)
63000 S=R7-R4*X
63100 DO 91 L=KK,K
63200 LL=MM(L)
63300 91 Q(LL)=S+X*Q(LL)
63400 KK=K+1
63500 80 CONTINUE
63600
63700 IF(KK.GT.K)GO TO 180
63800 C THIS FOR ITEMS BEYOND LAST IMPORTANT ITEM.
63900 R7=Q(LL)-R5
64000 C R7=NEW POS. OF LAST IMPORTANT ITEM. R5=OLD POS.
64100 DO 280 L=KK,K
64200 LL=MM(L)
64300 280 Q(LL)=R7+Q(LL)
64400 180 JJ=JJ2-2
64500 L=JJ2
64600 M=0
64700 C FLAG FOR REST AT START OF LINE
64800
64900 JJJ=-1
65000 C FLAG FOR 1ST BAR OF LINE 12/77
65100 V=0
65200 ACCI=0
65300 DO 12 J=1,JJ
65400 R=CODEN(KPN,J,Q,LA)
65500 CC IF(CODEN(KPN,J,Q,LA).NE.4)GO TO 12
65600 IF(R.EQ.4)GO TO 680
65700 IF(M)GO TO 780
65800 IF(R.NE.2)GO TO 780
65900 IF(KBR.EQ.0)GO TO 12
66000 C LOOK FOR RESTS AT FRONT OF LINE.
66100 X=0
66200 CALL TURN(J,JJ,1,X)
66300 PGTRN(KBR)=PGTRN(KBR)+X
66400 M=-1
66500 780 IF(R.NE.1)GO TO 12
66600 IF(V.NE.Q(LA+3))GO TO 782
66700 IF(JACC)GO TO 781
66800 782 IF(AMOD(Q(LA+5),10.0).EQ.0)GO TO 781
66900 JACC=-1
67000 ACCI=ACCI+.5
67100 V=Q(LA+3)
67200 781 M=-1
67300 IF(NOGRCE)GO TO 12
67400 C NEXT TO GIVE EQUAL SPACE FOR EVERY GRACE NOTE
67500 C FOUND A NOTE
67600 IF(Q(LA+9).GT.0.05)GO TO 12
67700 C JUMP IF NOT A GRACE NOTE
67800 R=Q(LA+2)
67900 C THE STAFF NUM.
68000 DO 580 LF=J+1,JJ
68100 IF(CODEN(KPN,LF,Q,JD).NE.1)GO TO 580
68200 IF(Q(JD+2).NE.R)GO TO 580
68300 IF(Q(JD).LT.7)GO TO 580
68400 IF(Q(JD+9).EQ.0)GO TO 580
68500 C CHORD NOTE
68600 R4=Q(LA+3)
68700 CC R4=Q(LA+3)-1
68800 R5=Q(JD+3)
68900 C THE STAFF # IS IN R2
69000 R8=RSTFAC(IFIX(R2+1))+.5
69100 IF(Q(JD+4).LT.80)R8=R8*2
69200 C INSURES SPACE BETWEEN GRACE NOTE AND NEXT NOTE
69300 R8=R5-R8
69400 CC R8=R5-R8-1
69500 CCC IF(R4.EQ.R5)GO TO 12
69600 IF(R4.NE.R5)GO TO 480
69700 C GRACE NOTE AT START OF LINE ***** FIX THIS????
69800 DO 880 KE=1,LF-1
69900 880 Q(KPN(KE)+3)=R8
70000 C MOVE THE GRACE NOTE, AND OTHER STUFF, TO LEFT.
70100 GO TO 12
70200 480 R2=Q(LA+2)
70300 R9=R5
70400 CALL PTMOVE(Q,KPN)
70500 CC TYPE 9999,Q(J+3),Q(JD+3)
70600 CC9999 FORMAT(2F)
70700 GO TO 12
70800 580 CONTINUE
70900 GO TO 12
71000 C ABOVE FOR GRACE NOTE SPACING.
71100 680 KBR=KBR+1
71200 C BAR LINE COUNTER
71300 T=Q(LA+3)
71400 C TOTAL SPACE
71500 X=0
71600 CALL TURN(J-1,1,-1,X)
71700 CALL TURN(J+1,JJ,1,X)
71800 222 PGTRN(KBR)=X
71900 C FINDS PAGE-TURN POSSIBILITIES
72000 C CHANGE ALL VALUES TO 4/5 OF THEIR CURRENT SIZE.
72100 IF(JJJ)RNEXT=RNEXT-6
72200 C JJJ=-1 IF 1ST BAR OF LINE. 12/77
72300 JJJ=0
72400 BARS(KBR)=(T-RNEXT+ACCI)*BFAC
72500 C SIZE OF THIS MEASURE + .5*ACCIDENTALS
72600 ACCI=0
72700 K=J
72800 RNEXT=T
72900 12 CONTINUE
73000
73100 IF(K.NE.JJ)RNEXT=Q(KPN(JJ)+3)
73200 RNEXT=RNEXT+3
73300 JJ2=L
73400 C JJ2 GETS WIPED OUT IN PTMOVE, SO GET IT BACK HERE
73500 CC???380 LCNT=0
73600 CC??? NDPY=0
73700 C JJ2 IS END OF PNTR DATA
73800 JPQ=KPN(JJ2-1)+1
73900 CALL PUTEXT(NMPG,'PAG')
74000 CALL EXTOUT(RSTFAC,128)
74100 CALL EXTOUT(PN,JJ2)
74200 CALL EXTOUT(Q,JPQ)
74300 CALL FINEXT
74400
74500 LASTNM=NMPG
74600 NMPG=NMPG+2
74700 IF(NMPG.EQ.'PAGEZ'+2)NMPG='PAGFA'
74800 C WILL GO FROM PAGEA TO PAGFZ, ETC. (104) ADD TO THIS IF NEEDED.
74900 IF(NMPG.EQ.'PAGFZ'+2)NMPG='PAGGA'
75000 IF(NMPG.EQ.'PAGGZ'+2)NMPG='PAGHA'
75100 122 ENDLN=RNEXT
75200 END